home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / nwlib15.zip / DEMO.ZIP / SEMAPHR.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-03  |  3KB  |  104 lines
  1. unit Semaphr;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, 
  7.   WinTypes, 
  8.   WinProcs, 
  9.   Messages, 
  10.   Classes, 
  11.   Graphics, 
  12.   Controls,
  13.   Forms, 
  14.   Dialogs, 
  15.   NWServer, 
  16.   Nwtools, 
  17.   ExtCtrls, 
  18.   StdCtrls, Buttons, Spin;
  19.  
  20. type
  21.   TwinSemaphore = class(TForm)
  22.     Label1: TLabel;
  23.     counter: TEdit;
  24.     Timer1: TTimer;
  25.     NWTools1: TNWTools;
  26.     NWServer1: TNWServer;
  27.     Label2: TLabel;
  28.     Label3: TLabel;
  29.     semaValue: TEdit;
  30.     Label4: TLabel;
  31.     valueSpinner: TSpinButton;
  32.     BitBtn1: TBitBtn;
  33.     procedure Timer1Timer(Sender: TObject);
  34.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  35.     procedure FormShow(Sender: TObject);
  36.     procedure valueSpinnerDownClick(Sender: TObject);
  37.     procedure valueSpinnerUpClick(Sender: TObject);
  38.   private
  39.     { Private declarations }
  40.   public
  41.     { Public declarations }
  42.   end;
  43.  
  44. var
  45.   winSemaphore: TwinSemaphore;
  46.  
  47. implementation
  48.  
  49. {$R *.DFM}
  50.  
  51. var
  52.   semaphoreHandle : TNWSemaHandle ;
  53.  
  54.  
  55. procedure TwinSemaphore.FormShow(Sender: TObject);
  56.   begin
  57.     semaphoreHandle := createSemaphore(0,'NWLIB',10) ;  {ie, a 10-station semaphore} 
  58.     if (semaphoreHandle < 1) then    
  59.       begin                   
  60.         alertBox('Error Creating/Accessing Semaphore Handle;;' +
  61.                  'Maximum Semaphore Stations May be Reached');
  62.         valueSpinner.enabled := false ;
  63.       end
  64.     else
  65.       timer1Timer(sender) ;
  66.   end;
  67.  
  68. procedure TwinSemaphore.FormClose(Sender: TObject;
  69.                                   var Action: TCloseAction);
  70.   begin
  71.     { always clean up your mess! }
  72.     freeSemaphore(0,semaphoreHandle);
  73.     action := caFree ;
  74.   end;
  75.  
  76. procedure TwinSemaphore.Timer1Timer(Sender: TObject);
  77.   var
  78.     value : word ;
  79.   begin
  80.     timer1.enabled := false ;
  81.     value          := 0 ;
  82.     counter.text := intToStr(querySemaphore(0,semaphoreHandle,value)) ;
  83.     semaValue.text := intToStr(value) ;
  84.     timer1.enabled := true ;
  85.   end;
  86.  
  87. procedure TwinSemaphore.valueSpinnerDownClick(Sender: TObject);
  88.   { the Semaphore Value is a counter within the semaphore that you
  89.     can use any way you like, independently of maxInstances }
  90.   begin
  91.     if not decSemaValue(0,semaphoreHandle,1) then
  92.       okbox('We''re Plum Out of Semaphore Values!') ;
  93.     timer1Timer(sender) ;
  94.   end;
  95.  
  96. procedure TwinSemaphore.valueSpinnerUpClick(Sender: TObject);
  97.   begin
  98.     if not incSemaValue(0,semaphoreHandle,5) then
  99.       okbox('Ahg...She Won''t Take Any More, Captain!') ;
  100.     timer1Timer(sender) ;
  101.   end;
  102.  
  103. end.
  104.